Sky at Night 2006 September/SAN CD 9-2006 CD-ROM 16.iso/pc/Software/Network Telescope Control/NTC-Setup.Exe/Source/ntc_server_comms.pas

Pascal/Delphi Source File | 2006-03-24 | 62.7 KB | 2,522 lines

unit ntc_server_comms;
{
    Copyright (C) 2004 - 2006 Andrew Sprott

    http://astronomy.crysania.co.uk
    [e-mail]

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}

interface

uses
    Windows,
    Messages,
    SysUtils,
    Variants,
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    StdCtrls,
    ExtCtrls,
    inifiles,

    ntc_server_form,
    ntc_server_object;

const
    { scope response timeout [5 seconds default] }
    response_timeout=5000;
    { io handing }
    max_buffer_size=4096;
    in_buffer_size=max_buffer_size;
    out_buffer_size=max_buffer_size;
    { port handling }

    north=0;
    south=1;
    east=2;
    west=3;

    invalid_reading=65535;

    { meade }
    hms_s=8;    { HH:MM:SS }
    hmt_s=7;    { HH:MM.T# }
    ams_s=9;    { sDD*MMíSS }
    am_s=6;        { sDD*MM }
    dms_s=9;    { sDD*MMíSS }
    dm_s=8;        { sDD*MM }
    ddms_s=9;    { DDD*MMíSS }
    ddmt_s=8;    { DDD*MM#T }

    { celestron }
    hex_16=4;
    hex_16_r=65536;
    hex_32=8;
    hex_32_r=4294967296;

    max_speeds=2;

type
    short=array[1..2] of byte;
    long=array[1..4] of byte;

    p_command_record=^command_record;
    command_record=record
        last_command,
        next_command:p_command_record;
        command,
        scope_write:string;
        appends,
        returns:boolean;
        in_text_1,
        in_text_2:string[64];
        out_text_1,
        out_text_2:string[32];
        default_string:string;
    end;

    buffer_type=array[1..max_buffer_size] of byte;

    Tscope_comms = class(tform)
        comms_panel: TPanel;
        port_group: TGroupBox;
        serial_label: TLabel;
        speed_label: TLabel;
        parity_label: TLabel;
        bits_label: TLabel;
        stop_bits_label: TLabel;
        timeout_label: TLabel;
        interval_label: TLabel;
        speed_edit: TComboBox;
        port_edit: TComboBox;
        parity_edit: TComboBox;
        data_bits_edit: TComboBox;
        stop_bits_edit: TComboBox;
        timeout_edit: TComboBox;
        interval_edit: TComboBox;
        response_timer: TTimer;

        { form handling }
        procedure formcreate(
            Sender:TObject);

        procedure kill;

        { configuration }
        procedure load_settings;

        procedure save_settings;

        procedure read_escape_scopes;

        procedure create_command_record(
            name,
            out_string:string;
            does_append:boolean;
            out_1,
            out_2:string;
            does_return:boolean;
            in_1,
            in_2,
            string_that_is_default:string);

        { events }
        procedure FormShow(
            Sender: TObject);

        procedure adjust;

        procedure check_activate(
            Sender: TObject);

        { scope connecting }
        Function connect_to_scope
            :boolean;

        Function disconnect_from_scope
            :boolean;

        { communications }
        Function open
            :boolean;

        Procedure close;

        Function read(
            default_string:string)
            :response_type;

        Function read_timeout(
            default_string:string)
            :boolean;

        Function write(
            b:string)
            :boolean;

        Procedure clear_port;

        { scope commands }
        function tell(
                    message_text:string;
            var return_object:tscope_object)
            :string;

        { logging }
        Procedure init_log_file(
            s:string);

        Procedure write_log(
            e:string);

        procedure update_status_log(
            m:string);

        Procedure close_log;

        procedure form_close_query(
                    Sender: TObject;
            var CanClose: Boolean);

        procedure timeout_editChange(
            Sender: TObject);

        procedure interval_editChange(
            Sender: TObject);

        procedure response_timerTimer(
            Sender: TObject);

    private
        { Private declarations }
        scope_handle:thandle;
        port_file_open:boolean;
        { logging }
        log_handle:textfile;
        log_filename:string;
        { io }
        port:string;
        timeout,
        interval:longint;
        response_timed_out:boolean;
        command_last,
        first_command:p_command_record;
        work_buffer:buffer_type;
        wb_size:integer;
    public
        { Public declarations }
        command_list:tstringlist;
        precision_format:integer;
        port_opened,
        scope_connected:boolean;
        { configuration }
        dimensions:dimensions_record;
        { logging }
        message_logging,
        io_logging,
        file_logging:boolean;

        { events }
        procedure check_visible_and_show_hide(
            sender:tobject);

        procedure hide_form;
        procedure show_form;
    end;

var
    scope_comms: Tscope_comms;

implementation

uses
    ntc_server_info,
    ntc_server_network,
    ntc_server_control,
    ntc_server_config,
    ntc_server_search,
    ntc_server_focus;

{$R *.dfm}

    { -------------
        form handling
        ------------- }

procedure tscope_comms.formcreate(
    Sender:TObject);
begin
    port_file_open:=false;
    response_timer.enabled:=false;
    response_timed_out:=false;
    load_settings;
    if message_logging then
        scope_comms.init_log_file('ntc.log');
end;

procedure tscope_comms.kill;
begin
    if port_opened then
        begin
            disconnect_from_scope;
            port_opened:=false;
        end;
end;

    { -------
        logging
        ------- }

Procedure tscope_comms.init_log_file(
    s:string);
var
    io:integer;
begin
    try
        log_filename:=application_path+s;
        {$I-}
        assignfile(log_handle,log_filename);
        {$I+}
        io:=ioresult;
        if io=0 then
            begin
                rewrite(log_handle);
                writeln(log_handle,DateTimeToStr(now)+' : session started');
                close_log;
            end
        else
            update_status_log('cant create log file : '+log_filename);
    except
        on err:exception do
            begin
                update_status_log('failed to open log : '+err.message);
            end;
    end;
end;

Procedure tscope_comms.write_log(
    e:string);
var
    io:integer;
begin
    if message_logging then
        begin
            try
                {$I-}
                assignfile(log_handle,log_filename);
                {$I+}
                io:=ioresult;
                if io=0 then
                    begin
                        append(log_handle);
                        writeln(log_handle,FormatDateTime('hh:mm:ss.zzz',now)+' : '+e);
                        close_log;
                    end
                else
                    update_status_log('cant open log : '+log_filename);
            except
                on err:exception do
                    begin
                        update_status_log('failed to write to log : '+err.message);
                        close_log;
                    end
            end;
        end;
end;

Procedure tscope_comms.close_log;
var
    io:integer;
begin
    try
        {$I-}
        closefile(log_handle);
        {$I+}
        io:=ioresult;
        if io<>0 then
            update_status_log('failed to close : '+log_filename+' : '+inttostr(io));
    except
        on err:exception do
            update_status_log('failed to close log : '+err.message);
    end;
end;

procedure tscope_comms.update_status_log(
    m:string);
begin
    if io_logging then
        scope_network.update_status_log_check(m);
end;

    { -------------
        communication
        ------------- }

Function tscope_comms.open
    :boolean;
var
    t:tcommtimeouts;
    dcb:tdcb;
    e,c:String;
begin
    update_status_log('open >>');
    result:=false;
    port:=port_edit.text;
    timeout:=strtointdef(timeout_edit.text,1000);
    interval:=strtointdef(interval_edit.text,100);
    c:='baud='+speed_edit.text+
        ' parity='+parity_edit.text[1]+
        ' data='+data_bits_edit.text+
        ' stop='+stop_bits_edit.text;
    update_status_log(
        'connect_to_serial_port : '+port+' '+c+' : '+
        timeout_edit.text+' '+interval_edit.text);
    if port_file_open then
        close;
    scope_handle:=CreateFile(
        PChar(port),
        generic_write or generic_read,
        0,
        nil,
        open_existing,
        file_attribute_normal,
        0);
    if scope_handle<>invalid_handle_value then
        begin
            port_file_open:=true;
            if not SetupComm(scope_handle,in_buffer_size,out_buffer_size) then
                e:='setupcom failed'
            else if not GetCommState(scope_handle,dcb) then
                e:='getcommstate failed'
            else if not BuildCommdcb(PChar(c),dcb) then
                e:='buildcommdcb failed'
            else if not SetCommState(scope_handle,dcb) then
                e:='setcomstate failed'
            else
                e:='';
            if e<>'' then
                update_status_log(e)
            else
                begin
                    { set timeouts }
                    t.ReadIntervalTimeout:=interval;
                    t.ReadTotalTimeoutMultiplier:=0;
                    t.ReadTotalTimeoutConstant:=timeout;
                    t.WriteTotalTimeoutMultiplier:=0;
                    t.WriteTotalTimeoutConstant:=timeout;
                    SetCommTimeouts(scope_handle,t);
                    result:=true;
                    clear_port;
                    update_status_log(port+' : opened');
                end;
        end;
    update_status_log('<< open');
end;

Procedure tscope_comms.close;
begin
    CloseHandle(scope_handle);
    port_file_open:=false;
    update_status_log(port+' : closed');
end;

Procedure tscope_comms.clear_port;
var
    t:TCOMMTIMEOUTS;
begin
    update_status_log('clear_port >>');
    if scope_config.scope_enabled then
        begin
            t.ReadIntervalTimeout:=10;
            t.ReadTotalTimeoutMultiplier:=0;
            t.ReadTotalTimeoutConstant:=10;
            t.WriteTotalTimeoutMultiplier:=0;
            t.WriteTotalTimeoutConstant:=timeout;
            SetCommTimeouts(scope_handle,t);
            try
                read('');
            finally
                update_status_log('cleared port');
                t.ReadIntervalTimeout:=interval;
                t.ReadTotalTimeoutMultiplier:=0;
                t.ReadTotalTimeoutConstant:=timeout;
                t.WriteTotalTimeoutMultiplier:=0;
                t.WriteTotalTimeoutConstant:=timeout;
                SetCommTimeouts(scope_handle,t);
            end;
        end;
    update_status_log('<< clear_port');
end;

Function tscope_comms.read(
    default_string:string)
    :response_type;
var
    c,n:Cardinal;
    io:integer;
    s:array[1..max_buffer_size] of byte;
    i,r:integer;
begin
    update_status_log('read >>');
    wb_size:=0;
    work_buffer[1]:=0;
    r:=0;
    for i:=1 to max_buffer_size do
        s[i]:=0;
    result:=[exit_ok];
    if port_opened then
        begin
            if scope_config.scope_enabled then
                begin
                    repeat
                        n:=0;
                        c:=max_buffer_size;
                        {$I-}
                        ReadFile(scope_handle,pchar(s[1])^,c,n,nil);
                        {$I+}
                        io:=ioresult;
                        if (io=0) and (n<>0) then
                             for i:=1 to n do
                            begin
                                work_buffer[i+r]:=s[i];
                                inc(r,n);
                            end;
                    until (io<>0) or (n=0);
                    wb_size:=r;
                    work_buffer[wb_size+1]:=0;
                    if io<>0 then
                        begin
                            update_status_log('read : error : '+inttostr(io));
                            close;
                            result:=[exit_fail];
                        end
                    else
                        begin
                            update_status_log(
                                'Read : '+inttostr(r)+' : '+pchar(work_buffer[1]));
                            if r=0 then
                                result:=[exit_void];
                        end;
                end
            else for i:=1 to length(default_string) do
                work_buffer[i]:=byte(default_string[i]);
        end
    else if scope_config.scope_enabled then
        begin
            update_status_log('fail : port not opened');
            result:=[exit_fail];
        end
    else for i:=1 to length(default_string) do
        work_buffer[i]:=byte(default_string[i]);
    update_status_log(pchar(@work_buffer[1])^+' <<  read');
end;

Function tscope_comms.read_timeout(
    default_string:string)
    :boolean;
var
    exit_type:response_type;
    done:boolean;
begin
    while response_timer.enabled do
        update_status_log('<< waiting');
    response_timed_out:=false;
    response_timer.interval:=response_timeout;
    response_timer.enabled:=true;
    wb_size:=0;
    done:=false;
    while not done do
        begin
            if not response_timed_out then
                begin
                    exit_type:=read(default_string);
                    if exit_type*[exit_void]=[] then
                        done:=true
                    else
                        application.processmessages;
                end
            else
                begin
                    exit_type:=[exit_fail];
                    done:=true;
                end;
        end;
    response_timer.enabled:=false;
    result:=exit_type>=[exit_ok];
    response_timed_out:=false;
end;

Function tscope_comms.write(
    b:string)
    :boolean;
var
    c,
    n:cardinal;
    e:boolean;
    io:integer;
begin
    update_status_log('write  >> '+b);
    if port_opened then
        begin
            if scope_config.scope_enabled then
                begin
                    n:=0;
                    c:=length(b);
                    {$i-}
                    e:=writefile(scope_handle,pchar(b)^,c,n,nil);
                    {$i+}
                    io:=ioresult;
                    if not e or (io<>0) then
                        begin
                            update_status_log('write failed : '+inttostr(io));
                            result:=false;
                        end
                    else if c<>n then
                        begin
                            update_status_log('bytes to send : '+inttostr(c));
                            update_status_log('bytes written : '+inttostr(n));
                            result:=false;
                        end
                    else
                        begin
                            update_status_log(b+' : written');
                            result:=true;
                        end;
                end
            else
                result:=true;
        end
    else if scope_config.scope_enabled then
        begin
            update_status_log('fail : port not opened');
            result:=false;
        end
    else
        result:=true;
    update_status_log('<< write');
end;

    { ----------------
        scope connecting
        ---------------- }

Function tscope_comms.connect_to_scope
    :boolean;
var
    p,e:string;
begin
    update_status_log('connect_to_scope >>');
    if scope_config.scope_enabled then
        begin
            result:=false;
            p:=trim(port_edit.text);
            if pos(p,'COM1 COM2 COM3 COM4 COM5 COM6 COM7 COM8')=0 then
                begin
                    e:='Invalid communication port : '+p;
                    update_status_log(e);
                end
            else
                begin
                    if port_opened then
                        disconnect_from_scope;
                    if open then
                        begin
                            port_opened:=true;
                            scope_connected:=true;
                            { check scope connected }
                            case scope_config.scope_type of
                                lx200_type..autostar_type:
                                    begin
                                        p:=tell('get_ra_dec',current_object);
                                        if pos('ok',copy(p,1,2))>0 then
                                            begin
                                                scope_info.show_info;
                                                result:=true;
                                            end
                                        else
                                            begin
                                                result:=false;
                                                scope_connected:=false;
                                            end;
                                    end;
                                celestron_type:
                                    begin
                                        p:=tell('query',current_object);
                                        if pos('ok',copy(p,1,2))>0 then
                                            result:=true
                                        else
                                            begin
                                                result:=false;
                                                scope_connected:=false;
                                            end;
                                    end;
                             end;
                        end
                    else
                        begin
                            update_status_log('Port '+p+' cannot be opened!');
                            scope_connected:=false;
                        end;
                end;
        end
    else
        begin
            scope_info.show_info;
            scope_connected:=true;
            result:=true;
        end;
    update_status_log('connect_to_scope >>');
end;

Function tscope_comms.disconnect_from_scope
    :boolean;
begin
    if scope_config.scope_enabled then
        begin
            close;
            port_opened:=false;
            scope_connected:=false;
            result:=true;
        end
    else
        begin
            scope_connected:=false;
            result:=true;
        end;
    scope_search.search_timer.enabled:=false;
end;

    { -------------
        configuration
        ------------- }

procedure tscope_comms.load_settings;
begin
    ini_file:=tinifile.create(application_path+'server.ini');
    with ini_file do
        begin
            timeout_edit.text:=readstring('comms','timeout','100');
            interval_edit.text:=readstring('comms','interval','10');
            with port_edit do
                begin
                    text:=readstring('comms','comport','COM1');
                    if (length(text)<4) or
                         (strtointdef(text[4],1)>8) then
                        port_edit.text:='COM1';
                end;
            speed_edit.text:=readstring('comms','baud','9600');
            data_bits_edit.text:=readstring('comms','databits','8');
            parity_edit.text:=readstring('comms','parity','N');
            stop_bits_edit.text:=readstring('comms','stopbits','1');
            io_logging:=readbool('comms','io_logging',false);
            file_logging:=readbool('comms','file_logging',false);
            read_escape_scopes;
            { form }
            scope.get_dimensions(scope_comms,@dimensions,'comms',ini_file);
            left:=dimensions.form_left;
            top:=dimensions.form_top;
            visible:=readbool('comms','visible',false);
        end;
    ini_file.free;
end;

procedure tscope_comms.save_settings;
begin
    with ini_file do
        begin
            writestring('comms','timeout',timeout_edit.text);
            writestring('comms','interval',interval_edit.text);
            writestring('comms','comport',port_edit.text);
            writestring('comms','baud',speed_edit.text);
            writestring('comms','databits',data_bits_edit.text);
            writestring('comms','parity',parity_edit.text);
            writestring('comms','stopbits',stop_bits_edit.text);
            WriteInteger('comms','top',top);
            WriteInteger('comms','left',left);
            writeBool('comms','message_logging',message_logging);
            writebool('comms','io_logging',io_logging);
            writebool('comms','file_logging',file_logging);
            { form }
            scope.find_vdu(scope_comms,@dimensions);
            scope.write_dimensions(@dimensions,left,top,'comms',ini_file);
            writebool('comms','visible',visible);
        end;
end;

procedure tscope_comms.create_command_record(
    name,
    out_string:string;
    does_append:boolean;
    out_1,
    out_2:string;
    does_return:boolean;
    in_1,
    in_2,
    string_that_is_default:string);
var
    new_command:p_command_record;
begin
    new(new_command);
    with new_command^ do
        begin
            if command_last<>nil then
                begin
                    command_last.next_command:=new_command;
                    last_command:=command_last;
                end
            else
                last_command:=nil;
            next_command:=nil;
            command:=name;
            scope_write:=out_string;
            appends:=does_append;
            returns:=does_return;
            in_text_1:=in_1;
            in_text_2:=in_2;
            out_text_1:=out_1;
            out_text_2:=out_2;
            default_string:=string_that_is_default;
        end;
    command_last:=new_command;
end;

procedure Tscope_comms.read_escape_scopes;
var
    ini_file:tinifile;
    command_next:p_command_record;
    i:integer;
begin
    with scope_config do
         if scope_type=lx200_type then
        ini_file:=tinifile.create(application_path+'lx200.ini')
    else if scope_type=autostar_type then
        ini_file:=tinifile.create(application_path+'autostar.ini')
    else
        ini_file:=tinifile.create(application_path+'default.ini');
    with ini_file,scope_config do
         if scope_type=celestron_type then
        begin
            command_last:=nil;
            create_command_record('stopped',
                readstring('stopped','write','L'),
                readbool('stopped','append',false),
                '','',
                readbool('stopped','returns',true),
                readstring('stopped','valid','$valid=0#$'),
                '','0#');

            first_command:=command_last;

            create_command_record('query',
                readstring('query','write','?'),
                readbool('query','append',false),
                '','',
                readbool('query','returns',true),
                readstring('query','valid','$valid=#$'),
                '','#');

            create_command_record('get_ra_dec',
                readstring('get_ra_dec','write','E'),
                readbool('get_ra_dec','append',false),
                '','',
                readbool('get_ra_dec','returns',true),
                readstring('get_ra_dec','high','$ra_hex32$,$dec_hex32$#'),
                readstring('get_ra_dec','low','$ra_hex$,$dec_hex$#'),
                'ad35,cead#');

            create_command_record('get_az_alt',
                readstring('get_az_alt','write','Z'),
                readbool('get_az_alt','append',false),
                '','',
                readbool('get_az_alt','returns',true),
                readstring('get_az_alt','high','$az_hex32$,$alt_hex32$#'),
                readstring('get_az_alt','low','$az_hex$,$alt_hex$#'),
                '12f3,7698#');

            create_command_record('goto_ra_dec',
                readstring('goto_ra_dec','write','R'),
                readbool('goto_ra_dec','append',true),
                readstring('goto_ra_dec','high','$ra_hex32$,$dec_hex32$'),
                readstring('goto_ra_dec','low','$ra_hex$,$dec_hex$'),
                readbool('goto_ra_dec','returns',true),
                readstring('goto_ra_dec','valid','$valid=#$'),
                '','');

            create_command_record('goto_az_alt',
                readstring('goto_az_alt','write','B'),
                readbool('goto_az_alt','append',true),
                readstring('goto_az_alt','high','$az_hex32$,$alt_hex32$'),
                readstring('goto_az_alt','low','$az_hex$,$alt_hex$'),
                readbool('goto_az_alt','returns',true),
                readstring('goto_az_alt','valid','$valid=#$'),
                '','');

            create_command_record('get_ra_dec_bin',
                readstring('get_ra_dec_bin','write','E'),
                readbool('get_ra_dec_bin','append',false),
                '','',
                readbool('get_ra_dec_bin','returns',true),
                readstring('get_ra_dec_bin','high','$ra_bin32$$dec_bin32$'),
                readstring('get_ra_dec_bin','low','$ra_bin$$dec_bin$'),
                'ad35,cead#');

            create_command_record('get_az_alt_bin',
                readstring('get_az_alt_bin','write','Z'),
                readbool('get_az_alt_bin','append',false),
                '','',
                readbool('get_az_alt_bin','returns',true),
                readstring('get_az_alt_bin','high','$az_bin32$$alt_bin32$'),
                readstring('get_az_alt_bin','low','$az_bin$$alt_bin$'),
                '12f3,7698#');

            create_command_record('goto_az_alt_bin',
                readstring('goto_az_alt_bin','write','R'),
                readbool('goto_az_alt_bin','append',true),
                readstring('goto_az_alt_bin','high','$ra_bin32$$dec_bin32$'),
                readstring('goto_az_alt_bin','low','$ra_bin$$dec_bin$'),
                readbool('goto_az_alt_bin','returns',true),
                readstring('goto_az_alt_bin','valid','$valid=#$'),
                '','');

            create_command_record('goto_az_alt_bin',
                readstring('goto_az_alt_bin','write','B'),
                readbool('goto_az_alt_bin','append',true),
                readstring('goto_az_alt_bin','high','$az_bin32$$alt_bin32$'),
                readstring('goto_az_alt_bin','low','$az_bin$$alt_bin$'),
                readbool('goto_az_alt_bin','returns',true),
                readstring('goto_az_alt_bin','valid','$valid=#$'),
                '','');

            create_command_record('tracking_off',
                readstring('tracking_off','write','T0'),
                readbool('tracking_off','append',false),
                '','',
                readbool('tracking_off','returns',true),
                readstring('tracking_off','valid','$valid=#$'),
                '','');

            create_command_record('tracking_az',
                readstring('tracking_az','write','T1'),
                readbool('tracking_az','append',false),
                '','',
                readbool('tracking_az','returns',true),
                readstring('tracking_az','valid','$valid=#$'),
                '','');

            create_command_record('tracking_eq_north',
                readstring('tracking_eq_north','write','T2'),
                readbool('tracking_eq_north','append',false),
                '','',
                readbool('tracking_eq_north','returns',true),
                readstring('tracking_eq_north','valid','$valid=#$'),
                '','');

            create_command_record('tracking_eq_south',
                readstring('tracking_eq_south','write','T3'),
                readbool('tracking_eq_south','append',false),
                '','',
                readbool('tracking_eq_south','returns',true),
                readstring('tracking_eq_south','valid','$valid=#$'),
                '','');
        end
    else
        begin
            command_last:=nil;
            create_command_record('switch_precision',
                readstring('switch_precision','write','#:U#'),
                readbool('switch_precision','append',false),
                '','',
                readbool('switch_precision','returns',false),
                '','','');
            first_command:=command_last;

            create_command_record('query',
                readstring('query','write','#:GR#'),
                readbool('query','append',false),
                '','',
                readbool('query','returns',true),
                readstring('query','object','$*$'),'',
                'default test scope');

            if scope_type=lx200_type then
                create_command_record('stopped',
                    readstring('stopped','write',':D#'),
                    readbool('stopped','append',false),
                    '','',
                    readbool('stopped','returns',true),
                    readstring('stopped','valid','$valid=#$'),
                    '','#')
            else create_command_record('stopped',
                readstring('stopped','write',':D#'),
                readbool('stopped','append',false),
                '','',
                readbool('stopped','returns',true),
                readstring('stopped','valid','$valid!#$'),
                '','#');

            create_command_record('get_ra',
                readstring('get_ra','write','#:GR#'),
                readbool('get_ra','append',false),
                '','',
                readbool('get_ra','returns',true),
                readstring('get_ra','high','$hms$'),
                readstring('get_ra','low','$hmt$'),
                '12:08:54');

            create_command_record('get_dec',
                readstring('get_dec','write','#:GD#'),
                readbool('get_dec','append',false),
                '','',
                readbool('get_dec','returns',true),
                readstring('get_dec','high','$dms$'),
                readstring('get_dec','low','$dm$'),
                '+42fl08:59');

            create_command_record('get_alt',
                readstring('get_alt','write','#:GA#'),
                readbool('get_alt','append',false),
                '','',
                readbool('get_alt','returns',true),
                readstring('get_alt','high','$ams$'),
                readstring('get_alt','low','$am$'),
                '15fl46:12');

            create_command_record('get_az',
                readstring('get_az','write','#:GZ#'),
                readbool('get_az','append',false),
                '','',
                readbool('get_az','returns',true),
                readstring('get_az','high','$ddms$'),
                readstring('get_az','low','$ddmt$'),
                'P9fl27:27');

            create_command_record('set_ra',
                readstring('set_ra','write','#:Sr'),
                readbool('set_ra','append',true),
                readstring('set_ra','high','$hms$#'),
                readstring('set_ra','low','$hmt$#'),
                readbool('set_ra','returns',true),
                readstring('set_ra','valid','$valid=1$'),
                '','');

            create_command_record('set_dec',
                readstring('set_dec','write','#:Sd'),
                readbool('set_dec','append',true),
                readstring('set_dec','high','$dms$#'),
                readstring('set_dec','low','$dm$#'),
                readbool('set_dec','returns',true),
                readstring('set_dec','valid','$valid=1$'),
                '','');

            create_command_record('set_alt',
                readstring('set_alt','write','#:Sa'),
                readbool('set_alt','append',true),
                readstring('set_alt','high','$ams$#'),
                readstring('set_alt','low','$am$#'),
                readbool('set_alt','returns',true),
                readstring('set_alt','valid','$valid=1$'),
                '','');

            create_command_record('set_az',
                readstring('set_az','write','#:Sz'),
                readbool('set_az','append',true),
                readstring('set_az','high','$ddms$#'),
                readstring('set_az','low','$ddmt$#'),
                readbool('set_az','returns',false),
                '','','');

            create_command_record('slew_ra',
                readstring('slew_ra','write','#:MS#'),
                readbool('slew_ra','append',false),
                '','',
                readbool('slew_ra','returns',true),
                readstring('slew_ra','valid','$valid=0$'),
                '','0');

            create_command_record('slew_az',
                readstring('slew_az','write','#:MA#'),
                readbool('slew_az','append',false),
                '','',
                readbool('slew_az','returns',true),
                readstring('slew_az','valid','$valid=0$'),
                '','0');

            create_command_record('sync',
                readstring('sync','write','#:CM#'),
                readbool('sync','append',false),
                '','',
                readbool('sync','returns',true),
                readstring('sync','object','$*$'),'','');

            create_command_record('speed_slew',
                readstring('speed_slew','write','#:RS#'),
                readbool('speed_slew','append',false),
                '','',
                readbool('speed_slew','returns',false),
                '','','');

            create_command_record('speed_move',
                readstring('speed_move','write','#:RM#'),
                readbool('speed_move','append',false),
                '','',
                readbool('speed_move','returns',false),
                '','','');

            create_command_record('speed_guide',
                readstring('speed_guide','write','#:RG#'),
                readbool('speed_guide','append',false),
                '','',
                readbool('speed_guide','returns',false),
                '','','');

            create_command_record('speed_center',
                readstring('speed_centre','write','#:RC#'),
                readbool('speed_centre','append',false),
                '','',
                readbool('speed_centre','returns',false),
                '','','');

            create_command_record('speed',
                readstring('speed','write','#:Sw'),
                readbool('speed','append',true),
                readstring('speed','speed','$[2-4]$#'),'',
                readbool('speed','returns',true),
                readstring('speed','value','$*$'),'','');

            create_command_record('move_north',
                readstring('move_north','write','#:Mn#'),
                readbool('move_north','append',false),
                '','',
                readbool('move_north','returns',false),
                '','','');

            create_command_record('move_east',
                readstring('move_east','write','#:Me#'),
                readbool('move_east','append',false),
                '','',
                readbool('move_east','returns',false),
                '','','');

            create_command_record('move_south',
                readstring('move_south','write','#:Ms#'),
                readbool('move_south','append',false),
                '','',
                readbool('move_south','returns',false),
                '','','');

            create_command_record('move_west',
                readstring('move_west','write','#:Mw#'),
                readbool('move_west','append',false),
                '','',
                readbool('move_west','returns',false),
                '','','');

            create_command_record('stop_north',
                readstring('stop_north','write','#:Qn#'),
                readbool('stop_north','append',false),
                '','',
                readbool('stop_north','returns',false),
                '','','');

            create_command_record('stop_east',
                readstring('stop_east','write','#:Qe#'),
                readbool('stop_east','append',false),
                '','',
                readbool('stop_east','returns',false),
                '','','');

            create_command_record('stop_south',
                readstring('stop_south','write','#:Qs#'),
                readbool('stop_south','append',false),
                '','',
                readbool('stop_south','returns',false),
                '','','');

            create_command_record('stop_west',
                readstring('stop_west','write','#:Qw#'),
                readbool('stop_west','append',false),
                '','',
                readbool('stop_west','returns',false),
                '','','');

            create_command_record('stop_all',
                readstring('stop_all','write','#:Q#'),
                readbool('stop_all','append',false),
                '','',
                readbool('stop_all','returns',false),
                '','','');

            create_command_record('stop_move',
                readstring('stop_move','write','#:Q#:Qn#:Qs#:Qe#:Qw#'),
                readbool('stop_move','append',false),
                '','',
                readbool('stop_move','returns',false),
                '','','');

            create_command_record('focus_fast',
                readstring('focus_fast','write','#:FF#'),
                readbool('focus_fast','append',false),
                '','',
                readbool('focus_fast','returns',false),
                '','','');

            create_command_record('focus_slow',
                readstring('focus_slow','write','#:FS#'),
                readbool('focus_slow','append',false),
                '','',
                readbool('focus_slow','returns',false),
                '','','');

            create_command_record('focus_speed',
                readstring('focus_speed','write','#:F'),
                readbool('focus_speed','append',true),
                readstring('focus_speed','speed','$[1-4]$#'),
                '',
                readbool('focus_speed','returns',false),
                '','','');

            create_command_record('focus_in',
                readstring('focus_in','write','#:F+#'),
                readbool('focus_in','append',false),
                '','',
                readbool('focus_in','returns',false),
                '','','');

            create_command_record('focus_out',
                readstring('focus_out','write','#:F-#'),
                readbool('focus_out','append',false),
                '','',
                readbool('focus_out','returns',false),
                '','','');

            create_command_record('focus_stop',
                readstring('focus_stop','write','#:FQ#'),
                readbool('focus_stop','append',false),
                '','',
                readbool('focus_stop','returns',false),
                '','','');

            create_command_record('increase_tracking',
                readstring('increase_tracking','write','#:T+#'),
                readbool('increase_tracking','append',false),
                '','',
                readbool('increase_tracking','returns',false),
                '','','');

            create_command_record('decrease_tracking',
                readstring('decrease_tracking','write','#:T-#'),
                readbool('decrease_tracking','append',false),
                '','',
                readbool('decrease_tracking','returns',false),
                '','','');

            create_command_record('default_tracking',
                readstring('default_tracking','write','#:TQ#'),
                readbool('default_tracking','append',false),
                '','',
                readbool('default_tracking','returns',false),
                '','','');

            create_command_record('lunar_tracking',
                readstring('lunar_tracking','write','#:TL#'),
                readbool('lunar_tracking','append',false),
                '','',
                readbool('lunar_tracking','returns',false),
                '','','');

        end;
    command_next:=first_command;
    command_list:=nil;
    command_list:=tstringlist.create;
    while command_next<>nil do
         with command_list,command_next^ do
        begin
            i:=add(command);
            objects[i]:=tobject(command_next);
            command_next:=next_command;
        end;
    ini_file.free;
end;

    { --------------
        scope commands
        -------------- }

function tscope_comms.tell(
            message_text:string;
    var return_object:tscope_object)
    :string;
var
    option_names,
    option_values:tstrings;
    options_text,
    option_text,
    result_text,
    value_text:widestring;
    options,
    done:boolean;
    arg_i_1:integer;
    arg_s_1,
    arg_s_2,
    arg_s_3,
    e,s,t,
    response_text:string;
    i,j:integer;

    function parse_out(
        template:string;
        value_1,
        value_2:string)
        :string;
    var
        i,j,k,u,l:integer;
        b:boolean;
        f1,f2:double;
        w1:short;
        w2:long;
        sub,
        r:string;
        h:hms;
        d:dms;
        a:ams;

        function hexstr(
            b:double;
            w:integer)
            :string;
        var
            i,j:integer;
            t:string;
            c:char;
        begin
            t:=stringofchar('0',w);
            for i:=w downto 1 do
                begin
                    j:=trunc(b);
                    j:=j mod 16;
                    b:=b/16;
                    c:=chr(j+ord('0'));
                    if ord(c)>ord('9') then
                        c:=chr(ord(c)+7);
                    t[i]:=c;
                end;
            result:=t;
        end;

    begin
        b:=false;
        f1:=strtofloatdef(value_1,0);
        f2:=strtofloatdef(value_2,0);
        i:=1;
        r:='';
        result:='';
        while i<=length(template) do
            begin
                if template[i]='$' then
                    begin
                        b:=not b;
                        inc(i);
                    end
                else if b then
                     with scope_config do
                    begin
                        j:=pos('$',copy(template,i,length(template)));
                        if j>0 then
                             with return_object do
                            begin
                                sub:=copy(template,i,j-1);
                                { =====
                                    meade
                                    ===== }
                                { HH:MM:SS }
                                if sub='hms' then
                                    begin
                                        right_ascension_str(f1,h);
                                        r:=r+h.high;
                                    end
                                { HH:MM.T# }
                                else if sub='hmt' then
                                    begin
                                        right_ascension_str(f1,h);
                                        r:=r+h.low;
                                    end
                                { sDD*MMíSS }
                                else if sub='ams' then
                                    begin
                                        altitude_str(f1,a);
                                        r:=r+a.high;
                                    end
                                { sDD*MM }
                                else if sub='am' then
                                    begin
                                        altitude_str(f1,a);
                                        r:=r+a.low;
                                    end
                                { sDD*MM'SS }
                                else if sub='dms' then
                                    begin
                                        declination_str(f1,d);
                                        r:=r+d.high;
                                    end
                                { sDD*MM }
                                else if sub='dm' then
                                    begin
                                        declination_str(f1,d);
                                        r:=r+d.low;
                                    end
                                { DDD*MMíSS }
                                else if sub='ddms' then
                                    begin
                                        azimuth_str(f1,d);
                                        r:=r+d.high;
                                    end
                                { DDD*MM#T }
                                else if sub='ddmt' then
                                    begin
                                        azimuth_str(f1,d);
                                        r:=r+d.low;
                                    end
                                { =========
                                    celestron
                                    ========= }
                                else if sub='az_bin' then
                                    begin
                                        w1:=short(word(trunc(f1/degrees_in_quarter*hex_16_r)));
                                        r:=r+chr(w1[2])+chr(w1[1]);
                                    end
                                else if sub='az_hex' then
                                    r:=r+hexstr(f1/minutes_in_circle*hex_16_r,hex_16)
                                else if sub='az_bin32' then
                                    begin
                                        w2:=long(cardinal(
                                            trunc(f1/degrees_in_quarter*hex_32_r)));
                                        r:=r+chr(w2[4])+chr(w2[3])+chr(w2[2])+chr(w2[1]);
                                    end
                                else if sub='az_hex32' then
                                    r:=r+hexstr(f1/minutes_in_circle*hex_32_r,hex_16)
                                else if sub='alt_bin' then
                                    begin
                                        w1:=short(word(
                                            trunc(f2/degrees_in_quarter*hex_16_r)));
                                        r:=r+chr(w1[2])+chr(w1[1]);
                                    end
                                else if sub='alt_hex' then
                                    r:=r+hexstr(f2/minutes_in_circle*hex_16_r,hex_16)
                                else if sub='alt_bin32' then
                                    begin
                                        w2:=long(cardinal(
                                            trunc(f2/degrees_in_quarter*hex_32_r)));
                                        r:=r+chr(w2[4])+chr(w2[3])+chr(w2[2])+chr(w2[1]);
                                    end
                                else if sub='alt_hex32' then
                                    r:=r+hexstr(f2/minutes_in_circle*hex_32_r,hex_16)
                                else if sub='ra_bin' then
                                    begin
                                        w1:=short(word(
                                            trunc(f1/hours_in_circle*hex_16_r)));
                                        r:=r+chr(w1[2])+chr(w1[1]);
                                    end
                                else if sub='ra_hex' then
                                    r:=r+hexstr(f1/hours_minutes_in_circle*hex_16_r,hex_16)
                                else if sub='ra_bin32' then
                                    begin
                                        w2:=long(cardinal(
                                            trunc(f1/hours_in_circle*hex_32_r)));
                                        r:=r+chr(w2[4])+chr(w2[3])+chr(w2[2])+chr(w2[1]);
                                    end
                                else if sub='ra_hex32' then
                                    r:=r+hexstr(f1/hours_minutes_in_circle*hex_32_r,hex_16)
                                else if sub='dec_bin' then
                                    begin
                                        w1:=short(word(
                                            trunc(f2/degrees_in_quarter*hex_16_r)));
                                        r:=r+chr(w1[2])+chr(w1[1]);
                                    end
                                else if sub='dec_hex' then
                                    r:=r+hexstr(f2/minutes_in_circle*hex_16_r,hex_16)
                                else if sub='dec_bin32' then
                                    begin
                                        w2:=long(cardinal(
                                            trunc(f2/degrees_in_quarter*hex_32_r)));
                                        r:=r+chr(w2[4])+chr(w2[3])+chr(w2[2])+chr(w2[1]);
                                    end
                                else if sub='dec_hex32' then
                                    r:=r+hexstr(f2/minutes_in_circle*hex_32_r,hex_16)
                                else if sub[1]='[' then
                                    begin
                                        k:=strtointdef(value_1,-1);
                                        result:='fail : value out of range';
                                        if k>=0 then
                                            begin
                                                l:=strtointdef(sub[2],-1);
                                                if l>=0 then
                                                    begin
                                                        u:=strtointdef(sub[4],-1);
                                                        if u>=0 then
                                                            begin
                                                                if k<l then
                                                                    r:=r+inttostr(l)
                                                                else if k>u then
                                                                    r:=r+inttostr(u)
                                                                else
                                                                    r:=r+value_1;
                                                            end
                                                        else
                                                            exit;
                                                    end
                                                else
                                                    exit;
                                            end
                                        else
                                            exit;
                                    end
                                else
                                    begin
                                        result:='fail : unknown template : '+sub;
                                        exit;
                                    end;
                                inc(i,j-1);
                            end
                        else
                            begin
                                result:='fail : missing closing $';
                                exit;
                            end;
                    end
                else if template<>'' then
                    begin
                        r:=r+template[i];
                        inc(i);
                    end
                else
                    begin
                        result:='fail : end of template';
                        exit;
                    end;
            end;
        result:=r;
    end;

    procedure parse_in(
                template:string;
        var value:string);
    var
        i,j,m,w:integer;
        k,l:double;
        b:boolean;
        sub,
        e,q,r,s,t,x,wb:string;
        h:hms;
        d:dms;
        a:ams;

        function strtohex(
            var r:double;
                    b:integer)
                    :boolean;
        var
            i,j:integer;
            h:double;
            t:string;
        begin
            t:=copy(q,w,b);
            inc(w,b);
            q:=copy(q,w,length(q)-b);
            h:=1;
            r:=0;
            result:=true;
            for i:=b downto 1 do
                begin
                    j:=ord(t[i]);
                    if j>ord('9') then
                        begin
                            j:=j and $df-ord('0')-7;
                            if j>=16 then
                                begin
                                    result:=false;
                                    exit;
                                end;
                        end
                    else
                        begin
                            j:=j-ord('0');
                            if j<0 then
                                begin
                                    result:=false;
                                    exit;
                                end;
                        end;
                    r:=r+trunc(j*h);
                    h:=h*16;
                end;
        end;

    begin
        b:=false;
        for i:=1 to wb_size do
            wb:=wb+char(work_buffer[i]);
        i:=1;
        w:=1;
        r:='';
        q:=wb;
        x:='';
        while i<=length(template) do
            begin
                if template[i]='$' then
                    begin
                        b:=not b;
                        inc(i);
                    end
                else if b then
                     with scope_config do
                    begin
                        j:=pos('$',copy(template,i,length(template)));
                        if j>0 then
                             with return_object do
                            begin
                                sub:=copy(template,i,j-1);
                                h.high:='';
                                h.low:='';
                                d.high:='';
                                d.low:='';
                                { =====
                                    meade
                                    ===== }
                                { HH:MM:SS }
                                if sub='hms' then
                                    begin
                                        h.high:=copy(q,1,hms_s);
                                        inc(w,hms_s);
                                        if not str_right_ascension(h) then
                                            begin
                                                string(value):='fail : incorrect ra : '+sub;
                                                exit;
                                            end
                                        else
                                            x:=wb;
                                    end
                                { HH:MM.T# }
                                else if sub='hmt' then
                                    begin
                                        h.high:=copy(q,1,hmt_s);
                                        inc(w,hmt_s);
                                        if not str_right_ascension(h) then
                                            begin
                                                string(value):='fail : incorrect ra : '+sub;
                                                exit;
                                            end
                                        else
                                            x:=wb;
                                    end
                                { sDD*MMíSS }
                                else if sub='ams' then
                                    begin
                                        a.high:=copy(q,1,ams_s);
                                        inc(w,ams_s);
                                        if not str_altitude(a) then
                                            begin
                                                string(value):='fail : incorrect alt : '+sub;
                                                exit;
                                            end
                                        else
                                            x:=wb;
                                    end
                                { sDD*MM }
                                else if sub='am' then
                                    begin
                                        a.high:=copy(q,1,am_s);
                                        inc(w,am_s);
                                        if not str_altitude(a) then
                                            begin
                                                string(value):='fail : incorrect alt : '+sub;
                                                exit;
                                            end
                                        else
                                            x:=wb;
                                    end
                                { sDD*MMíSS }
                                else if sub='dms' then
                                    begin
                                        d.high:=copy(q,1,dms_s);
                                        inc(w,dms_s);
                                        if not str_declination(d) then
                                            begin
                                                string(value):='fail : incorrect dec : '+sub;
                                                exit;
                                            end
                                        else
                                            x:=wb;
                                    end
                                { sDD*MM }
                                else if sub='dm' then
                                    begin
                                        d.high:=copy(q,1,dm_s);
                                        inc(w,dm_s);
                                        if not str_declination(d) then
                                            begin
                                                string(value):='fail : incorrect dec : '+sub;
                                                exit;
                                            end
                                        else
                                            x:=wb;
                                    end
                                { DDD*MMíSS }
                                else if sub='ddms' then
                                    begin
                                        d.high:=copy(q,1,ddms_s);
                                        inc(w,ddms_s);
                                        if not str_azimuth(d) then
                                            begin
                                                string(value):='fail : incorrect az : '+sub;
                                                exit;
                                            end
                                        else
                                            x:=wb;
                                    end
                                { DDD*MM#T }
                                else if sub='ddmt' then
                                    begin
                                        d.high:=copy(q,1,ddmt_s);
                                        inc(w,ddmt_s);
                                        if not str_azimuth(d) then
                                            begin
                                                string(value):='fail : incorrect az : '+sub;
                                                exit;
                                            end
                                        else
                                            x:=wb;
                                    end
                                { =========
                                    celestron
                                    ========= }
                                else if sub='az_bin' then
                                    begin
                                        t:=copy(q,w,sizeof(short));
                                        k:=(byte(t[1])*256+byte(t[2]))/
                                            hex_16_r*degrees_in_circle;
                                        return_object.az:=k;
                                        inc(w,2);
                                    end
                                else if sub='az_hex' then
                                    begin
                                        if strtohex(k,hex_16) then
                                            begin
                                                k:=k/hex_16_r*minutes_in_circle;
                                                return_object.az:=k;
                                                x:='ok';
                                            end
                                        else
                                            begin
                                                string(value):='fail : incorrect az : '+sub;
                                                exit;
                                            end;
                                        inc(w,4);
                                    end
                                else if sub='az_bin32' then
                                    begin
                                        t:=copy(q,w,sizeof(long));
                                        k:=(byte(t[1])*4294967296+
                                            byte(t[2])*65536+
                                            byte(t[3])*256+
                                            byte(t[4]))/hex_32_r*degrees_in_circle;
                                        return_object.az:=k;
                                        inc(w,4);
                                    end
                                else if sub='az_hex32' then
                                    begin
                                        if strtohex(k,hex_32) then
                                            begin
                                                k:=k/hex_32_r*minutes_in_circle;
                                                return_object.az:=k;
                                                x:='ok';
                                            end
                                        else
                                            begin
                                                string(value):='fail : incorrect az : '+sub;
                                                exit;
                                            end;
                                        inc(w,8);
                                    end
                                else if sub='alt_bin' then
                                    begin
                                        t:=copy(q,w,sizeof(short));
                                        k:=(byte(t[1])*256+byte(t[2]))/
                                            hex_16_r*degrees_in_quarter;
                                        return_object.alt:=k;
                                        inc(w,2);
                                    end
                                else if sub='alt_hex' then
                                    begin
                                        if strtohex(k,hex_16) then
                                            begin
                                                k:=k/hex_16_r*minutes_in_circle;
                                                return_object.alt:=k;
                                                x:='ok';
                                            end
                                        else
                                            begin
                                                string(value):='fail : incorrect alt : '+sub;
                                                exit;
                                            end;
                                        inc(w,4);
                                    end
                                else if sub='alt_bin32' then
                                    begin
                                        t:=copy(q,w,sizeof(long));
                                        k:=(byte(t[1])*4294967296+
                                            byte(t[2])*65536+
                                            byte(t[3])*256+
                                            byte(t[4]))/hex_32_r*degrees_in_quarter;
                                        return_object.alt:=k;
                                        inc(w,4);
                                    end
                                else if sub='alt_hex32' then
                                    begin
                                        if strtohex(k,hex_32) then
                                            begin
                                                k:=k/hex_32_r*minutes_in_circle;
                                                return_object.alt:=k;
                                                x:='ok';
                                            end
                                        else
                                            begin
                                                string(value):='fail : incorrect alt : '+sub;
                                                exit;
                                            end;
                                        inc(w,8);
                                    end
                                else if sub='ra_bin' then
                                    begin
                                        t:=copy(q,w,sizeof(short));
                                        k:=(byte(t[1])*256+byte(t[2]))/
                                            hex_16_r*hours_in_circle;
                                        return_object.ra:=k;
                                        inc(w,2);
                                    end
                                else if sub='ra_hex' then
                                    begin
                                        if strtohex(k,hex_16) then
                                            begin
                                                k:=k/hex_16_r*hours_minutes_in_circle;
                                                return_object.ra:=k;
                                                x:='ok';
                                            end
                                        else
                                            begin
                                                string(value):='fail : incorrect ra : '+sub;
                                                exit;
                                            end;
                                        inc(w,4);
                                    end
                                else if sub='ra_bin32' then
                                    begin
                                        t:=copy(q,w,sizeof(long));
                                        k:=(byte(t[1])*4294967296+
                                            byte(t[2])*65536+
                                            byte(t[3])*256+
                                            byte(t[4]))/hex_32_r*hours_in_circle;
                                        return_object.ra:=k;
                                        inc(w,4);
                                    end
                                else if sub='ra_hex32' then
                                    begin
                                        if strtohex(k,hex_32) then
                                            begin
                                                k:=k/hex_32_r*hours_minutes_in_circle;
                                                return_object.ra:=k;
                                                x:='ok';
                                            end
                                        else
                                            begin
                                                string(value):='fail : incorrect ra : '+sub;
                                                exit;
                                            end;
                                        inc(w,8);
                                    end
                                else if sub='dec_bin' then
                                    begin
                                        t:=copy(q,w,sizeof(short));
                                        k:=(byte(t[1])*256+byte(t[2]))/
                                            hex_16_r*degrees_in_quarter;
                                        return_object.dec:=k;
                                        inc(w,2);
                                    end
                                else if sub='dec_hex' then
                                    begin
                                        if strtohex(k,hex_16) then
                                            begin
                                                k:=k/hex_16_r*minutes_in_circle;
                                                if k>minutes_in_semicircle then
                                                    k:=minutes_in_circle-k;
                                                return_object.dec:=k;
                                                x:='ok';
                                            end
                                        else
                                            begin
                                                string(value):='fail : incorrect dec : '+sub;
                                                exit;
                                            end;
                                        inc(w,4);
                                    end
                                else if sub='dec_bin32' then
                                    begin
                                        t:=copy(q,w,sizeof(long));
                                        k:=(byte(t[1])*4294967296+
                                            byte(t[2])*65536+
                                            byte(t[3])*256+
                                            byte(t[4]))/hex_32_r*degrees_in_quarter;
                                        return_object.dec:=k;
                                        inc(w,4);
                                    end
                                else if sub='dec_hex32' then
                                    begin
                                        if strtohex(k,hex_32) then
                                            begin
                                                k:=k/hex_32_r*minutes_in_circle;
                                                if k>minutes_in_semicircle then
                                                    k:=minutes_in_circle-k;
                                                return_object.dec:=k;
                                                x:='ok';
                                            end
                                        else
                                            begin
                                                string(value):='fail : incorrect dec : '+sub;
                                                exit;
                                            end;
                                        inc(w,8);
                                    end
                                else if copy(sub,1,5)='valid' then
                                    begin
                                        s:=copy(sub,6,length(sub));
                                        m:=length(q);
                                        if strtofloatdef(s,-1)>=0 then
                                            begin
                                                while copy(q,1,2)='00' do
                                                    begin
                                                        m:=m-1;
                                                        q:=copy(q,2,length(q));
                                                    end;
                                            end;
                                        t:=copy(q,1,length(s));
                                        if strtofloatdef(t,-1)>=0 then
                                            begin
                                                while (m>0) and  (t[m]<'0') and (t[m]>'9') do
                                                    begin
                                                        m:=m-1;
                                                        t:=copy(t,1,m);
                                                    end;
                                                e:='';
                                                while (length(s)>0) and ((s[1]<'0') or (s[1]>'9')) do
                                                    begin
                                                        e:=e+s[1];
                                                        s:=copy(s,2,length(s));
                                                    end;
                                                if s='' then
                                                    s:='0';
                                            end;
                                        k:=strtofloatdef(s,-1);
                                        l:=strtofloatdef(t,-1);
                                        if (k=-1) or (l=-1) then
                                            begin
                                                while pos(' ',q)>0 do
                                                    q:=copy(q,2,length(q)-1);
                                                e:=e+s[1];
                                                s:=copy(s,2,length(s));
                                                t:=copy(q,1,length(s));
                                                if ((e='=') and (s=t)) or
                                                     ((e='!') and (s<>t)) then
                                                    r:=r+'true'
                                                else
                                                    r:=r+'false';
                                            end
                                        else if ((e='=') and (k=l)) or
                                             ((e='<>') and (k<>l)) or
                                             ((e='>=') and (k>=l)) or
                                             ((e='<=') and (k<=l)) or
                                             ((e='>') and (k>l)) or
                                             ((e='<') and (k<l)) then
                                            r:=r+'true'
                                        else
                                            r:=r+'false';
                                        w:=m;
                                        if m<length(q) then
                                            r:=r+'=';
                                    end
                                else if sub[1]='*' then
                                    begin
                                        r:=r+q;
                                        w:=length(q);
                                        q:='';
                                    end
                                else
                                    begin
                                        string(value):='fail : unknown template : '+sub;
                                        exit;
                                    end;
                                q:=copy(q,w,length(q));
                                inc(i,j-1);
                                w:=1;
                            end
                        else
                            begin
                                string(value):='fail : missing closing $';
                                exit;
                            end;
                    end
                else if (template[i]<>'') and (q[w]<>'') then
                    begin
                        if template[i]=q[w] then
                            begin
                                inc(w);
                                inc(i);
                            end
                        else
                            begin
                                string(value):='fail : mismatched argument';
                                exit;
                            end;
                    end
                else
                    string(value):='fail : mismatched argument';
            end;
        string(value):=x+r;
    end;

    function send_command(
                scope_command:string;
                write_option_1,
                write_option_2:string;
        var read_option:string)
                :boolean;
    var
        variable_1,
        variable_2,
        template:string;
        scope_command_rec:p_command_record;
        i,j:integer;
    begin
        i:=command_list.indexof(scope_command);
        result:=true;
        with scope_network do
             if i>=0 then
            begin
                scope_command_rec:=p_command_record(command_list.objects[i]);
                with scope_command_rec^,scope_config,return_object do
                    begin
                        if write_option_1<>'' then
                            begin
                                i:=option_names.indexof(write_option_1);
                                j:=option_names.indexof(write_option_2);
                                if i>=0 then
                                    begin
                                        variable_1:=option_values[i];
                                        if j>=0 then
                                            variable_2:=option_values[j]
                                        else
                                            variable_2:='';
                                        if appends then
                                            begin
                                                if out_text_2<>'' then
                                                    begin
                                                        if high_precision then
                                                            template:=out_text_1
                                                        else
                                                            template:=out_text_2;
                                                        e:=parse_out(template,variable_1,variable_2);
                                                        write_option_1:=scope_write+e;
                                                    end
                                                else
                                                    begin
                                                        template:=out_text_1;
                                                        e:=parse_out(template,variable_1,variable_2);
                                                        write_option_1:=scope_write+e;
                                                    end;
                                                if pos(e,'fail')=1 then
                                                    begin
                                                        result:=false;
                                                        exit;
                                                    end
                                                else
                                                    begin
                                                        result:=write(write_option_1);
                                                        e:='';
                                                    end;
                                            end
                                        else if not write(scope_write) then
                                            begin
                                                e:='fail : write';
                                                result:=false;
                                                exit;
                                            end;
                                    end
                                else
                                    begin
                                        e:='fail : scope command not found';
                                        result:=false;
                                        exit;
                                    end;
                            end
                        else
                            result:=write(scope_write);
                        if returns then
                            begin
                                if read_timeout(default_string) then
                                    begin
                                        if in_text_2<>'' then
                                            begin
                                                if high_precision then
                                                    template:=in_text_1
                                                else
                                                    template:=in_text_2;
                                                parse_in(template,e);
                                            end
                                        else
                                            begin
                                                template:=in_text_1;
                                                parse_in(template,e);
                                            end;
                                        if pos('fail',e)<>1 then
                                            begin
                                                read_option:=e;
                                                e:='';
                                                result:=true;
                                            end
                                        else
                                            result:=false;
                                    end
                                else
                                    begin
                                        result:=false;
                                        e:='fail : read from scope failed';
                                    end;
                            end;
                    end;
            end
        else
            begin
                result:=false;
                e:='fail : '+scope_control.scope_name+' doesnt support '+scope_command;
            end;
    end;

    function find_option(
                option:string;
        var variable:string)
        :boolean;
    begin
        i:=option_names.indexof(option);
        if i>=0 then
            begin
                variable:=option_values[i];
                result:=true;
            end
        else
            result:=false;
    end;

    procedure add_option(
        name,
        value:string;
        bracket:boolean);
    begin
        result_text:=result_text+name+'='+value;
        if not bracket then
            result_text:=result_text+',';
    end;

    function tell_scope
        :string;
    begin
        result:='ok';
        response_text:='ok';
        e:='';
        result_text:='';
        trim(message_text);
        return_object:=tscope_object.create;
        i:=pos('(',message_text);
        if i>0 then
            begin
                options:=true;
                options_text:=copy(message_text,i+1,length(message_text));
                if options_text[length(options_text)]<>')' then
                    begin
                        update_status_log('no closing ) : '+message_text);
                        exit;
                    end;
                options_text:=copy(options_text,1,length(options_text)-1)+',';
                option_names:=tstringlist.create;
                option_values:=tstringlist.create;
                message_text:=copy(message_text,1,i-1);
                done:=false;
                while not done do
                    begin
                        i:=pos(',',options_text);
                        if i>0 then
                            begin
                                option_text:=copy(options_text,1,i-1);
                                options_text:=copy(options_text,i+1,length(options_text));
                                j:=pos('=',option_text);
                                if j>0 then
                                    begin
                                        value_text:=copy(option_text,j+1,length(option_text));
                                        option_text:=copy(option_text,1,j-1);
                                    end
                                else
                                    value_text:='';
                                option_names.add(option_text);
                                option_values.add(value_text);
                            end
                        else
                            done:=true;
                    end;
            end
        else
            begin
                options:=false;
                option_names:=nil;
                option_values:=nil;
            end;
        update_status_log('tell >>');
        with scope_network,scope_config,return_object do
            begin
                if message_text='connect' then
                    begin
                        update_status_log_header('connect');
                        if not connect_to_scope then
                            response_text:='fail : no connection'
                        else if scope_type=celestron_type then
                            begin
                                if (binary_mode and send_command('get_ra_dec_bin','','',t)) or
                                     (not binary_mode and send_command('get_ra_dec','','',t)) then
                                    scope_info.show_info
                                else
                                    e:='Scope not talking';
                            end
                        else if send_command('query','','',t) then
                            begin
                                if t<>'' then
                                    high_precision:=pos('.',t)<=0
                                else
                                    e:='scope not talking';
                            end
                        else
                            disconnect_from_scope;
                    end
                else if message_text='disconnect' then
                    begin
                        update_status_log_header('disconnect');
                        if not disconnect_from_scope then
                            response_text:='fail : cant disconnect';
                    end
                else if message_text='align' then
                    begin
                        update_status_log_header('align');
                        if send_command('set_ra','ra','',t) and
                             send_command('set_dec','dec','',t) then
                            send_command('sync','','',info);
                    end
                else if message_text='get_ra_dec' then
                    begin
                        update_status_log_header('get_ra_dec');
                        if scope_type=celestron_type then
                            begin
                                if (binary_mode and send_command('get_ra_dec_bin','','',t)) or
                                     (not binary_mode and send_command('get_ra_dec','','',t)) then
                                    begin
                                        if high_precision then
                                            add_option('precision','high',true)
                                        else
                                            add_option('precision','low',true);
                                    end;
                            end
                        else if send_command('get_ra','','',t) then
                            begin
                                if send_command('get_dec','','',t) then
                                    begin
                                        if high_precision then
                                            add_option('precision','high',true)
                                        else
                                            add_option('precision','low',true);
                                    end;
                            end;
                    end
                else if message_text='get_az_alt' then
                    begin
                        update_status_log_header('get_az_alt');
                        if scope_type=celestron_type then
                            begin
                                if (binary_mode and send_command('get_az_alt_bin','','',t)) or
                                     (not binary_mode and send_command('get_az_alt','','',t)) then
                                    begin
                                        if high_precision then
                                            add_option('precision','high',true)
                                        else
                                            add_option('precision','low',true);
                                    end;
                            end
                        else if send_command('get_az','','',t) then
                            begin
                                if send_command('get_alt','','',t) then
                                    begin
                                        if high_precision then
                                            add_option('precision','high',true)
                                        else
                                            add_option('precision','low',true);
                                    end;
                            end;
                    end
                else if message_text='switch_precision' then
                    begin
                        update_status_log_header('switch_precision');
                        send_command('switch_precision','','',t);
                    end
                else if message_text='focus_speed' then
                    begin
                        update_status_log_header(message_text);
                        send_command(message_text,'speed','',t);
                    end
                else if message_text='focus' then
                     with scope_focus do
                    begin
                        update_status_log_header('focus');
                        if find_option('dir',arg_s_1) and
                             find_option('speed',arg_s_2) and
                             find_option('timeout',arg_s_3) then
                            begin
                                if strtointdef(arg_s_2,0)>focus_speeds/max_speeds then
                                    done:=send_command('focus_fast','','',t)
                                else
                                    done:=send_command('focus_slow','','',t);
                                if not done then
                                    response_text:='fail'
                                else
                                    begin
                                        arg_i_1:=strtointdef(arg_s_3,min_timeout);
                                        if arg_i_1<min_timeout then
                                            arg_i_1:=min_timeout
                                        else if arg_i_1>max_timeout then
                                            arg_i_1:=max_timeout;
                                        if arg_s_1='+' then
                                            s:='focus_in'
                                        else if arg_s_1='-' then
                                            s:='focus_out'
                                        else
                                            response_text:='fail : unknown operand : '+arg_s_1;
                                    end;
                            end
                        else
                            response_text:='fail : cant find argument : dir';
                        if (pos('fail',response_text)<>1) and
                             not send_command(s,'','',t) then
                            update_status_log_failed
                        else if scope_enabled then
                            begin
                                focus_timeout:=arg_i_1;
                                enable_focus_timer;
                            end;
                    end
                else if message_text='stop_focus' then
                    begin
                        update_status_log_header('stop_focus');
                        send_command('focus_stop','','',t);
                    end
                else if message_text='goto_ra_dec' then
                    begin
                        update_status_log_header('goto_ra_dec');
                        if scope_type=celestron_type then
                            begin
                                if (binary_mode and
                                        not send_command('goto_ra_dec_bin','ra','dec',t)) or
                                     (not binary_mode and
                                        not send_command('goto_ra_dec','ra','dec',t)) then
                                    response_text:='fail : ';
                            end
                        else
                            begin
                                if send_command('set_ra','ra','',t) and
                                     send_command('set_dec','dec','',t) and
                                     send_command('slew_ra','','',t) and
                                     (t<>'true') then
                                    response_text:='fail : ';
                            end;
                    end
                else if message_text='goto_az_alt' then
                    begin
                        update_status_log_header('goto_az_alt');
                        if scope_type=celestron_type then
                            begin
                                if (binary_mode and
                                        not send_command('goto_ra_dec_bin','az','alt',t)) or
                                     (not binary_mode and
                                        not send_command('goto_ra_dec','az','alt',t)) then
                                    response_text:='fail : ';
                            end
                        else
                            begin
                                if send_command('set_az','az','',t) and
                                     send_command('set_alt','alt','',t) and
                                     send_command('slew_az','','',t) and
                                     (t<>'true') then
                                    response_text:='fail : ';
                            end;
                    end
                else if message_text='stopped' then
                    begin
                        update_status_log_header('stopped');
                        if not send_command('stopped','','',t) then
                            response_text:='fail : '
                        else
                            moving:=t='false';
                    end
                else if message_text='stop_all' then
                    begin
                        update_status_log_header(message_text);
                        send_command(message_text,'','',t);
                    end
                else if (message_text='increase_tracking') or
                                (message_text='decrease_tracking') or
                                (message_text='default_tracking') or
                                (message_text='lunar_tracking') then
                    begin
                        update_status_log_header(message_text);
                        send_command(message_text,'','',t);
                    end
                else if message_text='query' then
                    begin
                        update_status_log_header('query');
                        if not send_command('query','','',t) then
                            response_text:='fail : ';
                    end;
            end;
        if e<>'' then
            begin
                update_status_log('!!! failed !!!');
                update_status_log(e);
                response_text:=e;
            end;
        update_status_log('<< tell');
        result:=response_text;
    end;

begin
    result:=tell_scope;
    if options then
        begin
            option_names.free;
            option_values.free;
        end;
end;

    { ------
        events
        ------ }

procedure tscope_comms.FormShow(
    Sender: TObject);
begin
    with dimensions do
        begin
            top:=form_top;
            left:=form_left;
        end;
end;

procedure tscope_comms.adjust;
begin
    with dimensions do
        begin
            form_top:=trunc(form_top/last_screen_height*current_height);
            form_left:=trunc(form_left/last_screen_width*current_width);
        end;
    if visible then
        show;
end;

procedure tscope_comms.check_visible_and_show_hide(
    sender:tobject);
begin
    if visible then
        hide_form
    else
        show_form;
    scope.show_hide(sender,visible);
end;

procedure tscope_comms.hide_form;
begin
    with dimensions do
        begin
            form_top:=top;
            form_left:=left;
        end;
    Visible:=false;
end;

procedure tscope_comms.show_form;
begin
    Visible:=true;
end;

procedure Tscope_comms.check_activate(
    Sender: TObject);
begin
    scope.form_activate(scope_comms,@dimensions);
end;

procedure Tscope_comms.form_close_query(
            Sender: TObject;
    var CanClose: Boolean);
begin
    canclose:=false;
    visible:=false;
    with dimensions do
        begin
            form_top:=top;
            form_left:=left;
        end;
end;

procedure Tscope_comms.timeout_editChange(
    Sender: TObject);
begin
    timeout:=strtointdef(timeout_edit.text,1000);
end;

procedure Tscope_comms.interval_editChange(
    Sender: TObject);
begin
    interval:=strtointdef(interval_edit.text,100);
end;

    { ----------------
        response timeout
        ---------------- }

procedure Tscope_comms.response_timerTimer(
    Sender: TObject);
begin
    if scope_search.search_timer.enabled then
        scope_search.disable_timer;
    response_timer.enabled:=false;
    response_timed_out:=true;
end;

end.